home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Substring.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  5.5 KB  |  181 lines  |  [TEXT/R*ch]
  1. (* Substring -- 1995-06-15, 1997-06-03 *)
  2.  
  3. local 
  4.     prim_val sub_      : string -> int -> char         = 2 "get_nth_char";
  5.     prim_val mkstring_ : int -> string                 = 1 "create_string";
  6.     prim_val blit_     : string -> int -> string -> int -> int -> unit 
  7.                                                        = 5 "blit_string";
  8. in
  9.  
  10. type substring = string * int * int
  11. (* Invariant on values (s, i, n) of type substring:
  12.  *                  0 <= i <= i+n <= size s, 
  13.  * or equivalently, 0 <= i and 0 <= n and i+n <= size s.  
  14.  *)
  15.  
  16. fun base arg = arg
  17.     
  18. fun string (s, i, n) = 
  19.     let val newstr = mkstring_ n
  20.     in blit_ s i newstr 0 n; newstr end;
  21.  
  22. fun extract (s, i, NONE) =
  23.     if 0 <= i andalso i <= size s then (s, i, size s - i)
  24.     else raise General.Subscript
  25.   | extract (s, i, SOME n) =
  26.     if 0 <= i andalso 0 <= n andalso n <= size s - i then (s, i, n)
  27.     else raise General.Subscript
  28.  
  29. fun substring (s, i, n) = extract(s, i, SOME n);
  30.  
  31. fun all s = (s, 0, size s)
  32.  
  33. fun getc (s, i, 0) = NONE
  34.   | getc (s, i, n) = SOME(sub_ s i, (s, i+1, n-1))
  35.  
  36. fun first (s, i, n) = 
  37.     if n = 0 then NONE else SOME (sub_ s i);
  38.  
  39. fun isEmpty (s, i, n) = n=0;
  40.  
  41. fun triml k (s, i, n) = 
  42.     if k < 0 then raise Subscript
  43.     else if k > n then (s, i+n, 0) 
  44.     else (s, i+k, n-k);
  45.  
  46. fun trimr k (s, i, n) = 
  47.     if k < 0 then raise Subscript
  48.     else if k > n then (s, i, 0) 
  49.     else (s, i, n-k);
  50.  
  51. fun sub((s', i', n'), i) = 
  52.     if i<0 orelse i >= n' then raise Subscript
  53.     else sub_ s' (i'+i);
  54.  
  55. fun size (_, _, n) = n
  56.  
  57. fun slice ((s', i', n'), i, NONE) =
  58.     if 0 <= i andalso i <= n' then (s', i'+i, n'-i)
  59.     (* If the argument is valid, then so is the result:
  60.      *  0 <= i' <= i'+i <= i'+i + (n'-i) = i'+n' <= size s' *)
  61.     else raise Subscript
  62.   | slice ((s', i', n'), i, SOME n) =    
  63.     if 0 <= i andalso 0 <= n andalso i+n <= n' then (s', i'+i, n)
  64.     (* If the argument is valid, then so is the result:
  65.      *  0 <= i' <= i'+i <= i'+i + n <= i'+n' <= size s' *)
  66.     else raise Subscript
  67.  
  68. fun splitAt ((s, i, n), k) =
  69.     if k < 0 orelse k > n then raise Subscript
  70.     else ((s, i, k), (s, i+k, n-k));
  71.  
  72. fun concat strs =
  73.     let fun acc [] len                 = len
  74.           | acc ((_, _, len1)::vr) len = acc vr (len1 + len)
  75.         val len = acc strs 0
  76.         val newstr = if len > String.maxSize then raise Size 
  77.              else mkstring_ len 
  78.         fun copyall to []                   = () (* Now: to = len *)
  79.           | copyall to ((s1, i1, len1)::vr) = 
  80.         (blit_ s1 i1 newstr to len1; copyall (to+len1) vr)
  81.     in copyall 0 strs; newstr end;
  82.  
  83. fun compare ((s1, i1, n1), (s2, i2, n2)) =
  84.     let val stop = if n1 < n2 then n1 else n2
  85.     fun h j = (* At this point (s1, i1, j) = (s2, i2, j) *)
  86.         if j = stop then if      n1 < n2 then LESS
  87.                              else if n1 > n2 then GREATER
  88.                              else                 EQUAL
  89.         else
  90.         let val c1 = sub_ s1 (i1+j)
  91.             val c2 = sub_ s2 (i2+j)
  92.         in if c1 < c2 then LESS
  93.            else if c1 > c2 then GREATER
  94.            else h (j+1)
  95.         end
  96.     in h 0 end;
  97.  
  98. fun isPrefix s1 (s2, i2, n2) =
  99.     let val stop = if n2 < String.size s1 then n2 else String.size s1
  100.     fun h j = (* At this point (s1, 0, j) = (s2, i2, j) *)
  101.         j = stop orelse sub_ s1 j = sub_ s2 (i2+j) andalso h (j+1)
  102.     in String.size s1 <= n2 andalso h 0 end;
  103.  
  104. fun collate cmp ((s1, i1, n1), (s2, i2, n2)) =
  105.     let val stop = if n1 < n2 then n1 else n2
  106.     fun h j = (* At this point (s1, i1, j) = (s2, i2, j) *)
  107.         if j = stop then if      n1 < n2 then LESS
  108.                              else if n1 > n2 then GREATER
  109.                              else                 EQUAL
  110.         else
  111.         case cmp(sub_ s1 (i1+j), sub_ s2 (i2+j)) of
  112.             LESS    => LESS
  113.           | GREATER => GREATER
  114.           | EQUAL   => h (j+1)
  115.     in h 0 end;
  116.  
  117. fun foldl f e sus = Strbase.foldl f e sus;
  118.  
  119. fun foldr f e (s,i,n) = 
  120.     let fun h j res = if j<i then res 
  121.                       else h (j-1) (f (sub_ s j, res))
  122.     in h (i+n-1) e end;
  123.  
  124. fun explode (s, i, n) =
  125.     let fun h j res = if j<i then res
  126.               else h (j-1) (sub_ s j :: res)
  127.     in h (i+n-1) [] end;
  128.  
  129. fun app f ss = foldl (fn (x, _) => f x) () ss
  130.  
  131. exception Span
  132.  
  133. fun span ((s, i, n), (s', i', n')) = 
  134.     if i > i'+n' orelse s<>s' then 
  135.     raise Span
  136.     else
  137.     (s, i, i'+n'-i)
  138.  
  139. local 
  140.     open Strbase 
  141. in
  142.     val splitl = splitl
  143.     val splitr = splitr
  144.     val dropl  = dropl
  145.     val dropr  = dropr
  146.     val takel  = takel
  147.     val taker  = taker
  148.     val translate = translate
  149.     val tokens = tokens
  150.     val fields = fields
  151. end
  152.  
  153. (* An early test at the end of s may save much work if s begins with
  154.    many identical characters.  *)
  155.  
  156. fun position "" (ss as (s', i, n)) = ((s', i, 0), ss)
  157.   | position s (ss as (s', i, n)) =             
  158.     let val len1 = String.size s - 1    (* will be >= 0 *)
  159.     fun eq j k = j >= len1 orelse 
  160.                  sub_ s j = sub_ s' k andalso eq (j+1) (k+1)
  161.     val stop = i+n-len1-1
  162.     fun cmp k = 
  163.         if k>stop then     
  164.         (ss, (s', i+n, 0))                (* failure *)
  165.         else if sub_ s len1 = sub_ s' (k+len1) andalso eq 0 k then
  166.         ((s', i, k-i), (s', k, n-(k-i)))        (* success *)
  167.         else cmp(k+1)
  168.     in cmp i end;
  169.     
  170.     (* Above, (eq j k)  means that  (s,j,len1-j) = (s',k,len1-j), 
  171.            so s[len1] = s'[k+len1] and (eq 0 k) implies s = (s', k, len).
  172.        At successful termination, i <= k <= i+n-len, so 0 <= k-i <= n-len, 
  173.        and therefore n >= n-(k-i) >= len >= 0.  It follows that 
  174.        0 <= i <= i + (k-i) = k <= size s'     
  175.            and 
  176.        0 <= k <= k + n-(k-i) = n+i <= size s' (by (s', i, n) being valid),
  177.        so the resulting substrings are valid.
  178.     *)
  179.  
  180. end (* local *)
  181.